﻿<%
'''依赖层级:004
'''依赖文件:functions.asp, AshapoConfig.class.asp, AshapoPreg.class.asp, AshapoFso.class.asp
'''ASP功能扩展类
Class AshapoAsp

	'''最终执行代码的文件名(不含后缀)
	Private s_cacheFileName

	'内部使用AshapoConfig对象
	Private s_cfg
	
	'''内部使用AshapoFso对象名称
	Private s_fso
	
	'加载收集器
	Private s_collector
	
	'内部使用AhsapoPreg对象
	Private s_reg

	'''构造
	Private Sub Class_Initialize()
		Set s_cfg = New AshapoConfig
		Set s_fso = New AshapoFso
		
		Set s_collector = Server.CreateObject( s_cfg.Environment("Scripting.Dictionary") )
		
		Set s_reg = New AshapoPreg
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
		Set s_reg = Nothing
		Set s_collector = Nothing
		Set s_fso = Nothing
		Set s_cfg = Nothing
	End Sub
	
	'''判断指定的文件是否已加载进来
	'p_path:待判断文件的路径
	Private Function hasIncluded_(Byval p_path)
		Dim t_map_path : t_map_path = ASHAPO_RUNTIME_PATH & "/Cache/Map/ContextFree/" & s_cacheFileName
		
		If s_fso.IsFile(t_map_path) Then
			Dim t_maps : t_maps = Split( s_fso.ReadFile(t_map_path), "|" )
			If IsIn(s_fso.AbsPathForWeb(p_path), t_maps) Then
				hasIncluded_ = True
			Else
				hasIncluded_ = False
			End If
		Else
			hasIncluded_ = False
		End If	
	End Function
	
	'''从完整路径格式化得到待用函数名
	Private Function fullPathToFunName_(Byval p_fullpath)
		Dim t_funname
		t_funname = "ashapo_fun_" & p_fullpath 
		t_funname = Replace( t_funname, "/", "_1_" )
		t_funname = Replace( t_funname, ".", "_0_" )
		fullPathToFunName_ = t_funname
	End Function
	
	'''检查已加载的文件，如果文件已不存在则删去该加载记录
	'''注意，本函数并不处理已加载但不使用的情况，如果需要全部刷新，建议删除全部运行时文件
	Private Sub checkIncludedFiles_()
		'''上下文无关的INCLUDE处理
		Dim t_map_path1 : t_map_path1 = ASHAPO_RUNTIME_PATH & "/Cache/Map/ContextFree/" & s_cacheFileName
		If s_fso.IsFile(t_map_path1) Then
			Dim t_files1 : t_files1 = Split( s_fso.ReadFile(t_map_path1), "|" )
			Dim t_full_code1, t_delete_code1, t_file1, t_str1 : t_str1 = ""
			t_full_code1 = s_fso.ReadFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp" )
			Dim t_must_rebuild1 : t_must_rebuild1 = False
			For Each t_file1 In t_files1
				If s_fso.IsFile(t_file1) Then
					If t_str1 <> "" Then
						t_str1 = t_str1 & "|"
					End If
					t_str1 = t_str1 & t_file1
				Else
					t_must_rebuild1 = True
					t_delete_code1 = vbCrLf & "<!--#include virtual=""" & t_file1 & """-->"
					t_full_code1 = Replace( t_full_code1, t_delete_code1, "" )
				End If
			Next
			If t_must_rebuild1 Then
				Call s_fso.CreateFile(ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_full_code1, False)
				Call s_fso.CreateFile(t_map_path1, t_str1, True)
			End If
		End If
		'''上下文有关的INCLUDE处理
		Dim t_map_path2 : t_map_path2 = ASHAPO_RUNTIME_PATH & "/Cache/Map/ContextSensitive/" & s_cacheFileName
		If s_fso.IsFile(t_map_path2) Then
			Dim t_files2 : t_files2 = Split( s_fso.ReadFile(t_map_path2), "|" )
			Dim t_full_code2, t_delete_code2, t_file2, t_str2 : t_str2 = ""
			t_full_code2 = s_fso.ReadFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp" )
			Dim t_must_rebuild2 : t_must_rebuild2 = False
			For Each t_file2 In t_files2
				If s_fso.IsFile(t_file2) Then
					If t_str2 <> "" Then
						t_str2 = t_str2 & "|"
					End If
					t_str2 = t_str2 & t_file2
				Else
					t_must_rebuild2 = True
					t_delete_code2 = vbCrLf & "<" & "%Sub " & fullPathToFunName_(t_file2) & "()%" & "><!--#include virtual=""" & t_file2 & """--><" & "%End Sub%" & ">"
					t_full_code2 = Replace( t_full_code2, t_delete_code2, "" )
				End If
			Next
			If t_must_rebuild2 Then
				Call s_fso.CreateFile(ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_full_code2, False)
				Call s_fso.CreateFile(t_map_path2, t_str2, True)
			End If
		End If
	End Sub
	
	'''检验环境初始化，并实现环境初始化，必须在所有实际项目操作前先进行，否则会导致重复操作
	'p_name:要作为最终执行代码文件的文件名(不含后缀)
	Public Sub Init(p_name)
	
		s_cacheFileName = p_name
		
		If VarType(ASHAPO_DEBUG) <> vbEmpty And ASHAPO_DEBUG = True Then
			checkIncludedFiles_()
		End If
	
		If VarType(ASHAPO_COMPILED) <> vbEmpty And ASHAPO_COMPILED = True Then
			Exit Sub
		End If
		
		If Not s_fso.IsFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp" ) Then
			Dim t_code
			t_code = "<" & "%" & "Const ASHAPO_COMPILED = True" & "%" & ">" & vbCrLf
			t_code = t_code & "<!--#include virtual=""" & Request.ServerVariables("SCRIPT_NAME") & """-->"
			Call s_fso.CreateFile(ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_code, False)
		End If
		
		Server.Transfer( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp" )
	End Sub
	
	'''判断函数是否存在
	'p_fun_name:函数名称
	Public Function FunExists(Byval p_fun_name)
  		ON Error Resume Next
  		Dim t_o : Set t_o = GetRef(p_fun_name)
  		If Err Then
      		FunExists = False
  		Else
      		FunExists = True
  		End If
	End Function 
	
	'''由文件路径获取完整的include代码(包括内部再include)
	'p_p:文件路径
	Private Function incReadByFile_(Byval p_p)
		Dim t_c, t_m, t_rule, t_inc, t_incFile, t_incStr
		t_c = s_fso.ReadFile(p_p)
		If IsN(t_c) Then
			Exit Function
		End If
		t_c = s_reg.Replace(t_c, "<"&"%"&" *?@.*?%"&">", "")
		t_c = s_reg.Replace(t_c, "(<"&"%"&"[^>]+?)(option +?explicit)([^>]*?%"&">)", "$1'$2$3")
		t_rule = "<!-- *?#include +?(file|virtual) *?= *?""??([^"":?*\f\n\r\t\v]+?)""?? *?-->"
		If s_reg.Test(t_c, t_rule) Then
			Set t_inc = s_reg.Match(t_c,t_rule)
			For Each t_m In t_inc
				If LCase(t_m.SubMatches(0))="virtual" Then
					t_incFile = t_m.SubMatches(1)
				Else
					t_incFile = Mid(p_p,1,InstrRev(p_p, IIF(Instr(p_p,":")>0,"\","/"))) & t_m.SubMatches(1)
				End If
				t_incStr = incReadByFile_(t_incFile)
				t_c = Replace(t_c,t_m,t_incStr)
			Next
			Set t_inc = Nothing
		End If
		incReadByFile_ = t_c
	End Function
	
	'''格式化include代码
	'p_s:要格式化的代码
	Private Function getFinalCode_(Byval p_s)
		Dim t_ts, t_c, t_tc, t_sc, t_st, t_en
		
		'Unix到Dos
		'p_s = Replace(p_s, vbLf, vbCrLf)
		
		'格式化隔行/%/>/</%/这种情况,防止Select语句被非法阻断
		p_s = s_reg.Replace(p_s, "%"&">[\n\s*\r]+<"&"%", vbCrLf)
		
		'Response.Write(p_s)
		
		'开始
		t_c = "" : t_st = 1 : t_en = Instr(p_s,"<"&"%") + 2
		t_sc = "Response.Write "
		While t_en > t_st + 1
			t_ts = Mid(p_s, t_st, t_en-t_st-2)
			t_st = Instr(t_en, p_s, "%"&">") + 2
			If Has(t_ts) Then
				t_ts = Replace(t_ts, """", """""")
				t_ts = Replace(t_ts, vbCrLf, """&vbCrLf&""")
				t_c = t_c & t_sc & """" & t_ts & """" & vbCrLf
			End If
			t_ts = Mid(p_s, t_en, t_st-t_en-2)
			t_tc = s_reg.Replace(t_ts, "^\s*=\s*", t_sc) & vbCrLf
			t_c = t_c & t_tc
			t_en = Instr(t_st, p_s, "<"&"%") + 2
		Wend
		t_ts = Mid(p_s, t_st)
		If Has(t_ts) Then
			t_ts = Replace(t_ts, """", """""")
			t_ts = Replace(t_ts, vbcrlf, """&vbCrLf&""")
			t_c = t_c & t_sc & """" & t_ts & """" & vbCrLf
		End If
		
		''消除空行
		''getFinalCode_ = s_reg.Replace(t_c,"(\n\s*\r)+",vbCrLf)
		getFinalCode_ = s_reg.Replace(t_c, "(\n\s*\r)+", "")
	End Function
	
	'''载入上下文相关的文件，可以多次执行以实现重复载入
	'由于载入的文件作为一个方法来运行，因此不能含函数定义代码段、类定义代码段，只能是纯执行代码(可夹杂HTML)
	'p_path:要运行的代码文件路径
	Public Sub RunFile(Byval p_path)
		Dim t_fun_name : t_fun_name = fullPathToFunName_( s_fso.AbsPathForWeb( p_path ) )
		If FunExists( t_fun_name ) Then
			ExecuteGlobal( t_fun_name & "()" )
		Else
			Dim t_code : t_code = vbCrLf & "<" & "%Sub " & t_fun_name & "()%" & "><!--#include virtual=""" & s_fso.AbsPathForWeb( p_path ) & """--><" & "%End Sub%" & ">"
			
			Dim t_map_path : t_map_path = ASHAPO_RUNTIME_PATH & "/Cache/Map/ContextSensitive/" & s_cacheFileName
		
			If s_fso.IsFile(t_map_path) Then
				Dim t_maps : t_maps = Split( s_fso.ReadFile(t_map_path), "|" )
				If Not IsIn(s_fso.AbsPathForWeb(p_path), t_maps) Then
					Call s_fso.AppendFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_code )
					Call s_fso.AppendFile(t_map_path, "|" & s_fso.AbsPathForWeb(p_path))
				End If
			Else
				Call s_fso.AppendFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_code )
				Call s_fso.CreateFile(t_map_path, s_fso.AbsPathForWeb(p_path), True)
			End If
			
			Dim t_run_code : t_run_code = getFinalCode_( incReadByFile_(p_path) )
			On Error Resume Next
			ExecuteGlobal( t_run_code )
			If Err.Number<>0 Then
				
				'''直接刷新当前页面可以直接看到错误信息
				'Server.Transfer( Request.ServerVariables("SCRIPT_NAME") )
				
				Die("CORE ERROR 101:""" & p_path & """ code error [" & Err.Number & "], refresh page to see the reason.<br/>[" & Err.ASPDescription & "]")
			End If
		End If
	End Sub
	
	'''底层include
	'p_path:文件路径
	Private Sub coreInclude_(Byval p_path)
		s_collector(s_fso.AbsPath(p_path)) = "HAS_INCLUDED"
		Dim t_code : t_code = incReadByFile_(p_path)
		On Error Resume Next
		ExecuteGlobal(getFinalCode_(t_code))
		If Err.Number<>0 Then
			
			'''直接刷新当前页面可以直接看到错误信息
			'Server.Transfer( Request.ServerVariables("SCRIPT_NAME") )
			
			Die("CORE ERROR 102:""" & p_path & """ code error [" & Err.Number & "], refresh page to see the reason.<br/>[" & Err.ASPDescription & "]")
		End If
	End Sub
	
	'''上下文无关动态include
	'''由于是上下文无关，故重复include是不会产生效果的
	'p_path:文件路径
	Public Sub Include(Byval p_path)
		If hasIncluded_(p_path) Then
			'''todo 此处是否要抛出错误
			Exit Sub
		End If
		
		Dim t_code
		Dim t_map_path : t_map_path = ASHAPO_RUNTIME_PATH & "/Cache/Map/ContextFree/" & s_cacheFileName
		
		If s_fso.IsFile(t_map_path) Then
			Dim t_maps : t_maps = Split( s_fso.ReadFile(t_map_path), "|" )
			If IsIn(s_fso.AbsPathForWeb(p_path), t_maps) Then
				Exit Sub
			Else
				t_code = vbCrLf & "<!--#include virtual=""" & s_fso.AbsPathForWeb(p_path) & """-->"
				Call s_fso.AppendFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_code )
				Call s_fso.AppendFile(t_map_path, "|" & s_fso.AbsPathForWeb(p_path))
				Call coreInclude_(p_path)
			End If
		Else
			t_code = vbCrLf & "<!--#include virtual=""" & s_fso.AbsPathForWeb(p_path) & """-->"
			Call s_fso.AppendFile( ASHAPO_RUNTIME_PATH & "/Cache/Code/" & s_cacheFileName & ".asp", t_code )
			Call s_fso.CreateFile(t_map_path, s_fso.AbsPathForWeb(p_path), True)
			Call coreInclude_(p_path)
		End If		
	End Sub
End Class
%>